home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Zoom 2
/
Zoom - Release 2 (1996)(Active Software)[!].iso
/
misc
/
scion409
/
scionarexx.lha
/
Scion2Guide.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-07-01
|
34KB
|
1,105 lines
/*****************************************************************************
Scion2Guide.rexx
$VER: Scion2Guide 1.00 (24 June 1995)
An ARexx script to make ".guide" hypertexts from ScionGenealogist data bases
Derived from "Scion2html.rexx" by Harold H. Ipolyi, P.O.Box 891206,
Houston, Tx 77289-1206. (ipolyi@pat.mdc.com'). Also with assistance
from Freddy Ariës.
Thanks for doing all the HARD work, guys!
NOTE: This is version 1 and requires a lot more work. Especially
support for the new fields available with Scion version 4.
*****************************************************************************/
options RESULTS
arg outval
usereq = 1; /* change this to 0 if you don't want to use reqtools */
versionstr = "1.00"
outp = 1; output = stdout
prgrs = 1; pgopen = 0; /* use RexxArp progress indicator */
/* change prgrs to 0 for not using it */
NL = '0A'x
signal on IOERR
/* Parse command line to (maybe) turn off rexxreqtools and rexxarplib requesters */
do while outval = '?'
writeln(stdout, "NOREQ/S ")
pull outval
end
if outval = "NOREQ" then do
usereq = 0; prgrs = 0
end
/* add libraries */
libs = 'rexxsupport.library rexxarplib.library'
DO i = 1 TO Words(libs)
lib = Word(libs,i)
IF ~Show('Lib',lib) THEN DO
IF EXISTS('LIBS:'lib) then call addlib lib, 0, -30
ELSE DO
Tell('Cannot find' lib 'in LIBS:')
EXIT 10
END
END
END i
if usereq & ~show('l','rexxreqtools.library') then do
if exists('libs:rexxreqtools.library') then
call addlib('rexxreqtools.library',0,-30,0)
else do
usereq = 0;
Tell("Unable to open rexxreqtools.library - using text output")
end
end
if ~usereq then prgrs = 0
if prgrs & ~show('l','rexxarplib.library') then do
if exists('libs:rexxarplib.library') then
call addlib('rexxarplib.library',0,-30,0)
else
prgrs = 0
end
/* Check if Scion is running */
if ~show('P','SCIONGEN') then do
Tell("Please start the SCION program BEFORE using this script!")
EXIT
end
Address "SCIONGEN" /* Point at Scion Genealogist port */
'GETDBNAME' /* Issue GET DB NAME command to Scion Genealogist */
DBNAME = RESULT
'GETPROGVERSION'
VERSION = RESULT
IF VERSION < 4.07 THEN DO
if usereq then do
rtezrequest('Requires Scion Version 4.07'||NL||'(or greater)','Cancel','Scion2Guide Message:','rt_pubscrname = SCIONGEN')
EXIT
end
else do
Tell('Requires Scion Version 4.07 (or greater)')
EXIT
end
END
'GETTOTALIRN' /* Issue command to Scion Genealogist */
TOTALIRN = RESULT
if usereq = 1 then outp = 0 /* Essentially turns off stdout output */
/* Do we want to build a complete system, or just a single person? */
outoption = 1 /* Default is "all" */
if usereq then do
outoption = rtezrequest('Current Scion database: '||DBNAME||,
NL||'Which guide files do you want to create?'||,
NL,' _All People |_Specific Person | _Cancel','Scion2Guide v'||versionstr||' by Robbie Akins','rt_pubscrname = SCIONGEN')
select
when outoption = 2 then do /* Specific Person */
end
when outoption = 1 then do /* All */
end
otherwise
EXIT
end
end
else do
TellNN("Produce guides for (A)ll people or a (S)pecific person (A/S)? ")
pull choice
choice = UPPER(choice)
if left(choice,1) = 'A' then outoption = 1
if left(choice,1) = 'S' then outoption = 2
end
if outoption = 1 then target = 'NORMAL'
else do
/* If user asked for a specific person, get that person */
if usereq then do
target = rtgetlong(,'Enter specific IRN','Scion2Guide v'||versionstr,,'rtgl_min = 1 rtgl_max = 'TOTALIRN' rt_pubscrname = SCIONGEN',numresult)
if numresult = 0 then EXIT
if target = '' then EXIT
end
else do
TellNN("Enter IRN of person to create guide for: ")
pull target
TellNN("Continue (y/n)? ")
pull conf
conf = upper(conf)
/* Note that left works on empty strings ("") too! */
if left(conf,1) ~= "Y" then do
Tell("Goodbye...")
EXIT
end
Tell("")
end
end
/* We need a volume/directory requester to select output location */
outlocn = "RAM:" /* Default location */
if usereq then do
outlocn = rtfilerequest(,,'Select Location for Guides',,'rtfi_flags = freqf_nofiles rtfi_buffer = true rt_pubscrname = SCIONGEN rtfi_initialpath = RAM:',)
if outlocn = '' then EXIT
end
else do
TellNN("Enter location to store guide files in: ")
pull outlocn
lastchar = right(outlocn,1)
if lastchar ~= ":" then do
if lastchar ~= '/' then outlocn = outlocn'/'
end
TellNN("Continue (y/n)? ")
pull conf
conf = upper(conf)
/* Note that left works on empty strings ("") too! */
if left(conf,1) ~= "Y" then do
Tell("Goodbye...")
EXIT
end
Tell("")
end
/* Get path to database so can locate any note files in same location */
'GETDBPATH'
DBPATH = RESULT
/* Check if path ends with a ":". If not, append a "/" */
lastchar = right(DBPATH,1)
if lastchar ~= ":" then DBPATH = DBPATH'/'
Gdir = outlocn
Tell("Number of people in database "DBNAME" = "TOTALIRN)
Tell(' ')
IF IsNumeric(target) THEN
DO
Tell('Processing person 'target' of 'TOTALIRN' in database 'DBNAME)
IF target <= TOTALIRN THEN DO
CALL MakeOne(target,0)
END
END
ELSE
DO
Tell("Processing all "TOTALIRN" people in database "DBNAME)
/* FAMILYTREE.guide is a Scion data base IRN order list of all people in
amigaguide format:
person b:birthdate d:deathdate (()) father //\ mother */
Tell('File name: 'Gdir'FAMILYTREE.guide for: List of People.')
Open('GenealogyFile',Gdir'FAMILYTREE.guide','w')
WriteCh('GenealogyFile','@NODE Main ')
WriteLn('GenealogyFile','"List of People"')
WriteLn('GenealogyFile','List of People in data base "'DBNAME'". 'Time()' - 'Date()'')
WriteLn('GenealogyFile','')
DO i = 1 TO TOTALIRN
CALL MakeOne(i,1)
END
WriteLn('GenealogyFile','')
WriteLn('GenealogyFile','')
'GETPROGVERSION'
VERSION = RESULT
WriteCh('GenealogyFile','ScionGenealogist')
IF VERSION > 0 THEN WriteCh('GenealogyFile',' V 'VERSION)
WriteLn('GenealogyFile',' © Robbie J Akins; ')
WriteLn('GenealogyFile','Scion2guide.rexx by Robbie Akins (plus the help of H.Ipolyi and F.Ariës)')
WriteLn('GenealogyFile','@ENDNODE')
END
if pgopen then do
Postmsg()
pgopen = 0
end
if usereq then do
rtezrequest('Scion2guide.rexx'||NL||'completed normally','Okay','Scion2Guide Message:','rt_pubscrname = SCIONGEN')
end
else do
Tell(' ')
Tell('Scion2guide.rexx completed normally')
end
EXIT
END
/*****************************************************************************
* *
* Makeone is the procedure that does all the work! *
* *
*****************************************************************************/
MakeOne: PROCEDURE EXPOSE target DBNAME Gdir FAMLABEL1 FAMLABEL2 PERSLABEL1 PERSLABEL2 PERSLABEL3 DBPATH prgrs pgopen outp
PARSE ARG ScionIRN, EndOfFile
'EXISTPERSON' ScionIRN
if RESULT = 'YES' THEN DO
HasFileFATHER = 0
HasFileMOTHER = 0
HasMOTHER = 0
HasFATHER = 0
HasPARENTS = 0
HasCHILDREN = 0
'GETPARENTS' ScionIRN
PARENTS = RESULT
tPARENTSt = 't'PARENTS't'
IF tPARENTSt ~= 'tt' THEN HasPARENTS = 1
'GETMARRIAGE' ScionIRN 0 /* ??? GETTOTMARRIAGES IRN ??? */
MARRIAGE = RESULT
tMARRIAGESt = 't'MARRIAGE't'
IF tMARRIAGESt ~= 'tMARRIAGEt' THEN DO
mFGRN = MARRIAGE
'GETCHILD' mFGRN 0 /* ??? GETTOTCHILDREN FGRN ??? */
'EXISTPERSON' RESULT
if RESULT = 'YES' then HasCHILDREN = 1
END
'GETLASTNAME' ScionIRN
LASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' ScionIRN
FIRSTNAME = RESULT
'GETSEX' ScionIRN
GENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
thelastname = LASTNAME
thegender = GENDER
FULLNAME = GetFullName(FIRSTNAME)
MFULLNAME = MGetFullName(FIRSTNAME)
PFULLNAME = PGetFullName(FIRSTNAME)
'GETBIRTHDATE' ScionIRN
BIRTHDATE = RESULT
'GETBIRTHPLACE' ScionIRN
BIRTHPLACE = RESULT
'GETDEATHDATE' ScionIRN
DEATHDATE = RESULT
'GETDEATHPLACE' ScionIRN
DEATHPLACE = RESULT
'GETBURIALPLACE' ScionIRN
BURIALPLACE = RESULT
'GETOCCUPATION' ScionIRN
PERSOCCUPATION = CheckForReplacement(RESULT)
'GETPERSCOMMENT' ScionIRN
PERSCOMMENT = CheckForReplacement(RESULT)
'GETPERSREFS' ScionIRN
PERSREFS = CheckForReplacement(RESULT)
IF LASTNAME = "" THEN DO
Tell("Person " ScionIRN"'s last name is not defined")
Tell("No new guide file being created!")
RETURN
END
PfilN = 'P'ScionIRN
dPfilN = Gdir''PfilN
if prgrs then do
Postmsg(10, 10, "Scion2Guide (by Robbie Akins)\Database: "||DBNAME||"\Processing person: " ScionIRN, "SCIONGEN")
pgopen = 1
end
else do
Tell('')
Tell('Processing: 'dPfilN'.guide for: 'FULLNAME' {'ScionIRN'}')
end
Open('PERSONFILE',dPfilN'.guide','w')
WriteCh('PERSONFILE','@NODE Main ')
WriteLn('PERSONFILE','"'FULLNAME' Data Sheet"')
WriteCh('PERSONFILE',''MFULLNAME)
IF Exists(DBPATH'PN'ScionIRN'.'DBNAME) THEN DO
Tell('Writing info file 'dPfilN'I.guide')
Open('PNDBNAME',DBPATH'PN'ScionIRN'.'DBNAME,'r')
Open('PERSONI',dPfilN'I.guide','w')
WriteCh('PERSONI','@NODE Main ')
WriteLn('PERSONI','"'FULLNAME' Information"')
WriteCh('PERSONI','@{" 'MFULLNAME' " LINK 'PfilN'.guide/Main}')
WriteLn('PERSONI',' @{" List of people " LINK "FAMILYTREE.guide/Main"}')
DO While ~EOF('PNDBNAME')
line = ReadLn('PNDBNAME')
WriteLn('PERSONI',CheckForReplacement(line))
END
Close('PNDBNAME')
WriteLn('PERSONI','@ENDNODE')
Close('PERSONI')
WriteCh('PERSONFILE',' @{" More Info " LINK "'PfilN'I.guide/Main"}')
END
IF Exists(DBPATH'PP'ScionIRN'.'DBNAME) THEN DO
WriteCh('PERSONFILE',' @{" Picture " RXS "address command '"'display ")
WriteCh('PERSONFILE', DBPATH'PP'ScionIRN'.'DBNAME"'"'"')
WriteCh('PERSONFILE','}')
END
WriteLn('PERSONFILE',' @{" List of People " LINK "FAMILYTREE.guide/Main"}')
/* Underline name to make a bit more obvious! */
WriteLn('PERSONFILE',COPIES("=", LENGTH(MFULLNAME)))
IF BIRTHDATE || BIRTHPLACE ~= "" THEN DO
WriteCh('PERSONFILE','Born: ')
IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',BIRTHDATE)
IF BIRTHPLACE ~= "" THEN WriteCh('PERSONFILE',' Place:'BIRTHPLACE)
WriteLn('PERSONFILE','')
END
IF DEATHDATE ~= "" THEN WriteLn('PERSONFILE','Died:'DEATHDATE' Place:'DEATHPLACE)
IF BURIALPLACE ~= "" THEN WriteLn('PERSONFILE','Buried:'BURIALPLACE)
IF PERSOCCUPATION ~= "" THEN DO
WriteLn('PERSONFILE',"Occupation: "PERSOCCUPATION)
END
IF PERSCOMMENT ~= "" THEN DO
WriteLn('PERSONFILE',"Comments: "PERSCOMMENT)
END
IF PERSREFS ~= "" THEN DO
WriteLn('PERSONFILE',"References: "PERSREFS)
END
/* end of personal data; start family tree segment */
WriteLn('PERSONFILE','')
WriteLn('PERSONFILE',COPIES("=", 75)) /* Mark off "top" section */
WriteLn('PERSONFILE','Immediate Family of 'MFULLNAME)
WriteLn('PERSONFILE','')
IF HasPARENTS THEN DO
'GETPRINCIPAL' PARENTS
PRINCIPAL = RESULT
'GETSPOUSE' PARENTS
SPOUSE = RESULT
'GETMARRYDATE' PARENTS
PARENTSMARRIAGEDATE = RESULT
'GETMARRYPLACE' PARENTS
PARENTSmFGRNPLACE = RESULT
'GETCELEBRANT' PARENTS
PARENTSmFGRNCELEBRANT = CheckForReplacement(RESULT)
'GETFAMCOMMENT' PARENTS
PARENTSmFGRNCOMMENT = CheckForReplacement(RESULT)
'GETSEX' PRINCIPAL
IF RESULT = 'M' THEN
DO
FATHERScionIRN = PRINCIPAL
MOTHERScionIRN = SPOUSE
END
ELSE
DO
FATHERScionIRN = SPOUSE
MOTHERScionIRN = PRINCIPAL
END
'GETLASTNAME' FATHERScionIRN
FATHERLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' FATHERScionIRN
FATHERFIRSTNAME = RESULT
IF FATHERFIRSTNAME ~= "" | FATHERLASTNAME ~= "" THEN HasFATHER = 1
thelastname = FATHERLASTNAME
thegender = "m"
FATHERFULLNAME = GetFullName(FATHERFIRSTNAME)
MFATHERFULLNAME = MGetFullName(FATHERFIRSTNAME)
PFATHERFULLNAME = PGetFullName(FATHERFIRSTNAME)
'GETBIRTHDATE' FATHERScionIRN
FATHERBIRTHDATE = RESULT
'GETLASTNAME' MOTHERScionIRN
MOTHERLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' MOTHERScionIRN
MOTHERFIRSTNAME = RESULT
IF MOTHERFIRSTNAME ~= "" | MOTHERLASTNAME ~= "" THEN HasMOTHER = 1
thelastname = MOTHERLASTNAME
thegender = "f"
MOTHERFULLNAME = GetFullName(MOTHERFIRSTNAME)
MMOTHERFULLNAME = MGetFullName(MOTHERFIRSTNAME)
PMOTHERFULLNAME = PGetFullName(MOTHERFIRSTNAME)
'GETBIRTHDATE' MOTHERScionIRN
MOTHERBIRTHDATE = RESULT
IF FATHERLASTNAME ~= "" THEN DO
HasFileFATHER = 1
FATHERFILENAME = 'P'FATHERScionIRN
END
IF MOTHERLASTNAME ~= "" THEN DO
HasFileMOTHER = 1
MOTHERFILENAME = 'P'MOTHERScionIRN
END
WriteCh('PERSONFILE',' ')
IF HasFileFATHER THEN WriteCh('PERSONFILE','@{" 'MFATHERFULLNAME' " LINK "'FATHERFILENAME'.guide/Main"}')
IF HasFileFATHER THEN WriteCh('PERSONFILE',' //\ ')
IF HasFileMOTHER THEN WriteCh('PERSONFILE','@{" 'MMOTHERFULLNAME' " LINK "'MOTHERFILENAME'.guide/Main"}')
WriteLn('PERSONFILE','')
spcs = ' | '
WriteCh('PERSONFILE',spcs)
IF PARENTSMARRIAGEDATE ~= "" THEN
WriteCh('PERSONFILE','Married: 'PARENTSMARRIAGEDATE)
IF PARENTSmFGRNPLACE ~= "" THEN
WriteCh('PERSONFILE',' @ 'PARENTSmFGRNPLACE)
WriteLn('PERSONFILE','')
FfilN = Gdir'F'PARENTS
IF Exists(FfilN'I.guide') THEN DO
IF Exists(DBPATH'FN'PARENTS'.'DBNAME) THEN DO
Parse value StateF(FfilN'I.guide') with type size blk bits PFday PFmin PFtick com
Parse value StateF(DBPATH'FN'PARENTS'.'DBNAME) with type size blk bits PNday PNmin PNtick com
IF ( PNday > PFday ) | ( PNday = PFday & PNmin > PFmin ) THEN DO
Delete(FfilN'I.guide')
Tell('Scion file 'DBPATH'FN'PARENTS'.'DBNAME 'newer; replacing 'FfilN'I.guide')
END
END
END
Minfo = 0
IF Exists(FfilN'I.guide') THEN
Minfo = 1
ELSE DO
IF Exists(DBPATH'FN'PARENTS'.'DBNAME) THEN DO
Minfo = 1
Tell('Writing info file 'FfilN'I.guide')
Open('FNDBNAME',DBPATH'FN'PARENTS'.'DBNAME,'r')
Open('FAMILYI',FfilN'I.guide','w')
WriteCh('FAMILYI','@NODE Main ')
WriteLn('FAMILYI','"'FATHERFULLNAME' Family Info<rmation"')
WriteLn('FAMILYI',' @{" List of People " LINK "FAMILYTREE.guide/Main"}')
DO While ~EOF('FNDBNAME')
line = ReadLn('FNDBNAME')
WriteLn('FAMILYI',line)
END
Close('FNDBNAME')
WriteLn('FAMILYI','@ENDNODE')
Close('FAMILYI')
END
END
IF PARENTSmFGRNCELEBRANT ~= '' | Minfo THEN DO
WriteCh('PERSONFILE',spcs)
IF Minfo THEN
WriteCh('PERSONFILE','@{ " Family Info " LINK "F'PARENTS'I.guide/Main"} ')
IF Exists(DBPATH'FP'PARENTS'.'DBNAME) THEN DO
WriteCh('PERSONFILE','@{" Family Picture " RXS "address command '"'display ")
WriteCh('PERSONFILE', DBPATH'FP'PARENTS'.'DBNAME"'"'"')
WriteLn('PERSONFILE','}')
END
ELSE WriteLn('PERSONFILE','')
IF PARENTSmFGRNCELEBRANT ~= '' THEN DO
WriteLn('PERSONFILE',spcs''"Celebrant: "PARENTSmFGRNCELEBRANT)
END
END
IF PARENTSmFGRNCOMMENT ~= '' THEN DO
WriteLn('PERSONFILE',spcs''"Comments: "PARENTSmFGRNCOMMENT)
END
DO i = 0 TO 39 /* ??? GETTOTCHILDREN FGRN ??? */
'GETCHILD' PARENTS i
PARENTSc = RESULT
'GETFIRSTNAME' PARENTSc
PARENTScFIRSTNAME = RESULT
IF PARENTScFIRSTNAME ~= "" THEN DO
IF PARENTSc ~= ScionIRN THEN DO
'GETLASTNAME' PARENTSc
PARENTScLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' PARENTSc
PARENTScFIRSTNAME = RESULT
'GETSEX' PARENTSc
PARENTScGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
thelastname = PARENTScLASTNAME
thegender = PARENTScGENDER
PARENTScFULLNAME = GetFullName(PARENTScFIRSTNAME)
MPARENTScFULLNAME = MGetFullName(PARENTScFIRSTNAME)
PPARENTScFULLNAME = PGetFullName(PARENTScFIRSTNAME)
'GETBIRTHDATE' PARENTSc
PARENTScBIRTHDATE = RESULT
'GETDEATHDATE' PARENTSc
PARENTScDEATHDATE = RESULT
PARENTScFILENAME = 'P'PARENTSc
WriteCh('PERSONFILE',' |_____ @{" ')
IF PARENTScLASTNAME ~= FATHERLASTNAME THEN
WriteCh('PERSONFILE',MPARENTScFULLNAME)
ELSE DO
IF PARENTScGENDER = "m" THEN WriteCh('PERSONFILE',''PARENTScFIRSTNAME'')
IF PARENTScGENDER = "f" THEN WriteCh('PERSONFILE',''PARENTScFIRSTNAME'')
END
WriteCh('PERSONFILE',' " LINK "'PARENTScFILENAME'.guide/Main"}')
IF PARENTScBIRTHDATE ~= "" THEN
WriteCh('PERSONFILE',' b:'PARENTScBIRTHDATE)
IF PARENTScDEATHDATE ~= "" THEN
WriteCh('PERSONFILE',' d:'PARENTScDEATHDATE)
WriteLn('PERSONFILE','')
END
END
END
END
END
/* end of parents, siblings segment; start marriages segment */
vert.0 = ''
vert.1 = ' |'
DO i = 0 TO 39 /* ??? GETTOTMARRIAGES IRN ??? */
'GETMARRIAGE' ScionIRN i
MARRIAGE = RESULT /* use: 'EXISTFAMILY' */
IF MARRIAGE > -1 THEN DO
MARRIAGES = i
j = i + 1
vert.j = vert.i vert.1
END
END
tMARRIAGESt = 't'MARRIAGES't'
IF tMARRIAGESt ~= 'tMARRIAGESt' THEN DO
WriteLn('PERSONFILE',' |')
DO i = 0 TO MARRIAGES
'GETMARRIAGE' ScionIRN i
mFGRN = RESULT
IF mFGRN ~= "" THEN DO
ki = MARRIAGES - i + 1
IF ki ~= MARRIAGES + 1 THEN DO
WriteLn('PERSONFILE',vert.ki)
END
j = MARRIAGES + 1 - i
'GETSPOUSE' mFGRN
SPOUSE = RESULT
IF SPOUSE = ScionIRN THEN
DO
'GETPRINCIPAL' mFGRN
SPOUSE = RESULT
END
'GETLASTNAME' SPOUSE
SPOUSELASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' SPOUSE
SPOUSEFIRSTNAME = RESULT
thelastname = SPOUSELASTNAME
'GETSEX' SPOUSE
thegender = translate(RESULT,xrange('a','z'),xrange('A','Z'))
SPOUSEFULLNAME = GetFullName(SPOUSEFIRSTNAME)
MSPOUSEFULLNAME = MGetFullName(SPOUSEFIRSTNAME)
PSPOUSEFULLNAME = PGetFullName(SPOUSEFIRSTNAME)
'GETBIRTHDATE' SPOUSE
SPOUSEBIRTHDATE = RESULT
'GETMARRYDATE' mFGRN
MARRIAGEDATE = RESULT
'GETMARRYPLACE' mFGRN
mFGRNPLACE = RESULT
'GETCELEBRANT' mFGRN
MARRIAGECELEBRANT = CheckForReplacement(RESULT)
'GETFAMCOMMENT' mFGRN
MARRIAGECOMMENT = CheckForReplacement(RESULT)
SPOUSEFILENAME = 'P'SPOUSE
IF i = 0 THEN DO
WriteCh('PERSONFILE','# 'MFULLNAME' //\ ')
IF SPOUSELASTNAME ~= "" THEN
WriteCh('PERSONFILE','@{" ')
WriteCh('PERSONFILE',MSPOUSEFULLNAME)
IF SPOUSELASTNAME ~= "" THEN
WriteCh('PERSONFILE',' " LINK "'SPOUSEFILENAME'.guide/Main"}')
END
ELSE DO
WriteCh('PERSONFILE',vert.j'_ //\ ')
IF SPOUSELASTNAME ~= "" THEN
WriteCh('PERSONFILE','@{" ')
WriteCh('PERSONFILE',MSPOUSEFULLNAME)
IF SPOUSELASTNAME ~= "" THEN
WriteCh('PERSONFILE',' " LINK "'SPOUSEFILENAME'.guide/Main"}')
END
WriteLn('PERSONFILE','')
jk = MARRIAGES - i
spcs = vert.jk' | '
WriteCh('PERSONFILE',spcs)
IF MARRIAGEDATE ~= "" THEN
WriteCh('PERSONFILE',' m: 'MARRIAGEDATE)
IF mFGRNPLACE ~= "" THEN
WriteCh('PERSONFILE',' @ 'mFGRNPLACE)
WriteLn('PERSONFILE','')
FfilN = Gdir'F'mFGRN
Minfo = 0
IF Exists(DBPATH'FN'mFGRN'.'DBNAME) THEN DO
Minfo = 1
Tell('Writing info file 'FfilN'I.guide')
Open('FNDBNAME',DBPATH'FN'mFGRN'.'DBNAME,'r')
Open('FAMILYI',FfilN'I.guide','w')
WriteCh('FAMILYI','@NODE Main ')
WriteCh('FAMILYI','"'MFULLNAME' //\ ')
WriteLn('FAMILYI',MSPOUSEFULLNAME' Family Information"')
WriteCh('FAMILYI','Family of 'MFULLNAME' //\ ')
WriteCh('FAMILYI',MSPOUSEFULLNAME)
WriteLn('FAMILYI',' @{" List of people " LINK "FAMILYTREE.guide/Main"}')
DO While ~EOF('FNDBNAME')
line = ReadLn('FNDBNAME')
WriteLn('FAMILYI',CheckForReplacement(line))
END
Close('FNDBNAME')
WriteLn('FAMILYI','@ENDNODE')
Close('FAMILYI')
END
IF MARRIAGECELEBRANT ~= '' | Minfo THEN DO
WriteCh('PERSONFILE',spcs)
IF Minfo THEN
WriteCh('PERSONFILE',' @{" Family Info " LINK "F'mFGRN'I.guide/Main"}')
IF Exists(DBPATH'FP'mFGRN'.'DBNAME) THEN DO
WriteCh('PERSONFILE',' @{" Family Picture " RXS "address command '"'display ")
WriteCh('PERSONFILE', DBPATH'FP'mFGRN'.'DBNAME"'"'"')
WriteLn('PERSONFILE','}')
END
ELSE WriteLn('PERSONFILE','')
IF MARRIAGECELEBRANT ~= '' THEN DO
WriteLn('PERSONFILE',spcs' '"Celebrant: "MARRIAGECELEBRANT)
END
END
IF MARRIAGECOMMENT ~= '' THEN DO
WriteLn('PERSONFILE',spcs' '"Comments: "MARRIAGECOMMENT)
END
/*********************************************************************************/
DO k = 0 TO 39 /* ??? GETTOTCHILDREN FGRN ??? */
'GETCHILD' mFGRN k
mFGRNc = RESULT
'GETFIRSTNAME' mFGRNc
mFGRNcFIRSTNAME = RESULT
IF mFGRNcFIRSTNAME ~= "" THEN DO
HasCHILDREN = 1
'GETLASTNAME' mFGRNc
mFGRNcLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' mFGRNc
mFGRNcFIRSTNAME = RESULT
'GETSEX' mFGRNc
mFGRNcGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
thelastname = mFGRNcLASTNAME
thegender = mFGRNcGENDER
mFGRNcFULLNAME = GetFullName(mFGRNcFIRSTNAME)
MmFGRNcFULLNAME = MGetFullName(mFGRNcFIRSTNAME)
PmFGRNcFULLNAME = PGetFullName(mFGRNcFIRSTNAME)
'GETBIRTHDATE' mFGRNc
mFGRNcBIRTHDATE = RESULT
'GETDEATHDATE' mFGRNc
mFGRNcDEATHDATE = RESULT
mFGRNcFILENAME = 'P'mFGRNc
jk = MARRIAGES - i
WriteCh('PERSONFILE',vert.jk' |_____ @{" ')
IF mFGRNcLASTNAME ~= LASTNAME THEN
WriteCh('PERSONFILE',MmFGRNcFULLNAME)
ELSE DO
IF mFGRNcGENDER = "m" THEN WriteCh('PERSONFILE',''mFGRNcFIRSTNAME'')
IF mFGRNcGENDER = "f" THEN WriteCh('PERSONFILE',''mFGRNcFIRSTNAME'')
END
WriteCh('PERSONFILE',' " LINK "'mFGRNcFILENAME'.guide/Main"}')
IF mFGRNcBIRTHDATE ~= "" THEN
WriteCh('PERSONFILE',' b:'mFGRNcBIRTHDATE)
IF mFGRNcDEATHDATE ~= "" THEN
WriteCh('PERSONFILE',' d:'mFGRNcDEATHDATE)
Writeln('PERSONFILE','')
END
END
END
/*********************************************************************************/
END
END
ELSE DO
WriteLn('PERSONFILE',' |')
WriteLn('PERSONFILE',' 'MFULLNAME)
END
IF HasPARENTS THEN DO
WriteLn('PERSONFILE','')
WriteLn('PERSONFILE',COPIES("=", 75)) /* Mark off "top" section */
WriteLn('PERSONFILE','Ancestors of 'MFULLNAME)
WriteLn('PERSONFILE','')
Paternal(ScionIRN,' ')
WriteCh('PERSONFILE',MFULLNAME)
IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' b:'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('PERSONFILE',' d:'DEATHDATE)
WriteLn('PERSONFILE','')
Maternal(ScionIRN,' ')
END
IF HasCHILDREN THEN DO
WriteLn('PERSONFILE','')
WriteLn('PERSONFILE',COPIES("=", 75)) /* Mark off "top" section */
WriteLn('PERSONFILE','Descendants of 'MFULLNAME)
WriteLn('PERSONFILE','')
indent = " "
WriteCh('PERSONFILE',indent||MFULLNAME)
IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' b:'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('PERSONFILE',' d:'DEATHDATE)
WriteLn('PERSONFILE','')
marriagesANDchildren(ScionIRN,indent)
END
WriteLn('PERSONFILE','')
WriteLn('PERSONFILE','@ENDNODE')
Close('PERSONFILE')
IF target = "NORMAL" & LASTNAME ~= "" THEN DO
WriteCh('GenealogyFile','@{" ')
WriteCh('GenealogyFile',MFULLNAME)
WriteCh('GenealogyFile',' " LINK "'PfilN'.guide/Main"}')
IF BIRTHDATE ~= "" THEN WriteCh('GenealogyFile',' b:'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('GenealogyFile',' d:'DEATHDATE)
/*********************************************************************************/
IF HasFATHER THEN DO
WriteCh('GenealogyFile',' (()) ')
IF HasFileFATHER THEN WriteCh('GenealogyFile','@{" ')
WriteCh('GenealogyFile',' 'MFATHERFULLNAME)
IF HasFileFATHER THEN WriteCh('GenealogyFile',' " LINK "'FATHERFILENAME'.guide/Main"}')
IF HasMOTHER THEN DO
IF HasFATHER THEN WriteCh('GenealogyFile',' //\ ')
IF HasFileMOTHER THEN WriteCh('GenealogyFile','@{" ')
WriteCh('GenealogyFile',MMOTHERFULLNAME)
IF HasFileMOTHER THEN WriteCh('GenealogyFile',' " LINK "'MOTHERFILENAME'.guide/Main"}')
END
END
/*********************************************************************************/
WriteLn('GenealogyFile','') /* do not close, we have many more to go. */
END
RETURN
IsNumeric: PROCEDURE
PARSE ARG str
RETURN DataType(str, 'W')
/* create a file name short but unique */
FilName: PROCEDURE
PARSE ARG finm lanm bdate
RETURN Space(substr(finm,1,2) substr(lanm,1,4) bdate)
CheckForReplacement: PROCEDURE
PARSE ARG line "<" last
IF last = "" THEN RETURN CheckReplacement(line)
RIRN = GetRIRN(last || ".")
IF RIRN = 0 THEN RETURN line || "<" || last
last = CheckForReplacement(last) /* recursion */
lastend = GetEnd(last || ".")
'GETLASTNAME' RIRN
RIRNLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' RIRN
RIRNFIRSTNAME = RESULT
thelastname = RIRNLASTNAME
'GETBIRTHDATE' RIRN
RIRNBIRTHDATE = RESULT
'GETSEX' RIRN
IF translate(RESULT,xrange('a','z'),xrange('A','Z')) = "m" THEN
RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
ELSE
RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
IF RIRNLASTNAME = "" THEN
RETURN line || RIRNFULLNAME || lastend
RIRNFILENAME = 'P'RIRN
RETURN line || '@{" 'RIRNFULLNAME' " LINK "'RIRNFILENAME'.guide/Main"}' || lastend
CheckReplacement: PROCEDURE
PARSE ARG line "[" last
IF last = "" THEN RETURN line
RIRN = GetaRIRN(last || ".")
IF RIRN = 0 THEN RETURN line || "[" || last
last = CheckForReplacement(last) /* recursion */
lastend = GetaEnd(last || ".")
'GETLASTNAME' RIRN
RIRNLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' RIRN
RIRNFIRSTNAME = RESULT
thelastname = RIRNLASTNAME
'GETBIRTHDATE' RIRN
RIRNBIRTHDATE = RESULT
'GETSEX' RIRN
IF translate(RESULT,xrange('a','z'),xrange('A','Z')) = "m" THEN
RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
ELSE
RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
IF RIRNLASTNAME = "" THEN
RETURN line || RIRNFULLNAME || lastend
RIRNFILENAME = 'P'RIRN
RETURN line || '@{" 'RIRNFULLNAME' " LINK "'RIRNFILENAME'.guide/Main"}' || lastend
Paternal: PROCEDURE
PARSE ARG irn, indent
'GETPARENTS' irn
PARENTS = RESULT
'GETPRINCIPAL' PARENTS
PRINCIPAL = RESULT
'GETSPOUSE' PARENTS
SPOUSE = RESULT
'GETSEX' PRINCIPAL
IF RESULT = 'M' THEN DO
FIRN = PRINCIPAL
MIRN = SPOUSE
END
ELSE DO
FIRN = SPOUSE
MIRN = PRINCIPAL
END
pirn = FIRN
IF 't'pirn't' ~= 'tt' THEN DO
Paternal(pirn,' 'indent)
'GETLASTNAME' pirn
pirnLASTNAME = GetLastName(RESULT)
thelastname = pirnLASTNAME
'GETFIRSTNAME' pirn
pirnFIRSTNAME = RESULT
pirnFULLNAME = GetFullName(pirnFIRSTNAME)
'GETBIRTHDATE' pirn
pirnBIRTHDATE = RESULT
IF pirnLASTNAME ~= "" THEN
pirnPfilN = 'P'pirn
WriteCh('PERSONFILE',indent'- ')
IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE','@{" ')
WriteCh('PERSONFILE',''pirnFULLNAME'')
IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE',' " LINK "'pirnPfilN'.guide/Main"}')
IF pirnBIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' b:'pirnBIRTHDATE)
'GETDEATHDATE' pirn
pirnDEATHDATE = RESULT
IF pirnDEATHDATE ~= "" THEN WriteCh('PERSONFILE',' d:'pirnDEATHDATE)
WriteLn('PERSONFILE','')
Maternal(pirn,' 'indent)
END
RETURN 0
Maternal: PROCEDURE
PARSE ARG irn, indent
'GETPARENTS' irn
PARENTS = RESULT
'GETPRINCIPAL' PARENTS
PRINCIPAL = RESULT
'GETSPOUSE' PARENTS
SPOUSE = RESULT
'GETSEX' PRINCIPAL
IF RESULT = 'M' THEN DO
FIRN = PRINCIPAL
MIRN = SPOUSE
END
ELSE DO
FIRN = SPOUSE
MIRN = PRINCIPAL
END
pirn = MIRN
IF 't'pirn't' ~= 'tt' THEN DO
Paternal(pirn,' 'indent)
'GETLASTNAME' pirn
pirnLASTNAME = GetLastName(RESULT)
thelastname = pirnLASTNAME
'GETFIRSTNAME' pirn
pirnFIRSTNAME = RESULT
pirnFULLNAME = GetFullName(pirnFIRSTNAME)
'GETBIRTHDATE' pirn
pirnBIRTHDATE = RESULT
IF pirnLASTNAME ~= "" THEN
pirnPfilN = 'P'pirn
WriteCh('PERSONFILE',indent'- ')
IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE','@{" ')
WriteCh('PERSONFILE',''pirnFULLNAME'')
IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE',' " LINK "'pirnPfilN'.guide/Main"}')
IF pirnBIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' b:'pirnBIRTHDATE)
'GETDEATHDATE' pirn
pirnDEATHDATE = RESULT
IF pirnDEATHDATE ~= "" THEN WriteCh('PERSONFILE',' d:'pirnDEATHDATE)
WriteLn('PERSONFILE','')
Maternal(pirn,' 'indent)
END
RETURN 0
marriagesANDchildren: PROCEDURE
PARSE ARG ScionIRN,indent
DO i = 0 TO 39 /* ??? GETTOTMARRIAGES IRN ??? */
'GETMARRIAGE' ScionIRN i
MARRIAGE = RESULT
IF MARRIAGE > -1 THEN DO
MARRIAGES = i
END
END
tMARRIAGESt = 't'MARRIAGES't'
IF tMARRIAGESt ~= 'tMARRIAGESt' THEN DO
DO i = 0 TO MARRIAGES
'GETMARRIAGE' ScionIRN i
mFGRN = RESULT
IF mFGRN ~= "" THEN DO
'GETSPOUSE' mFGRN
SPOUSE = RESULT
IF SPOUSE = ScionIRN THEN
DO
'GETPRINCIPAL' mFGRN
SPOUSE = RESULT
END
'GETLASTNAME' SPOUSE
SPOUSELASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' SPOUSE
SPOUSEFIRSTNAME = RESULT
thelastname = SPOUSELASTNAME
'GETSEX' SPOUSE
thegender = translate(RESULT,xrange('a','z'),xrange('A','Z'))
SPOUSEFULLNAME = GetFullName(SPOUSEFIRSTNAME)
MSPOUSEFULLNAME = MGetFullName(SPOUSEFIRSTNAME)
PSPOUSEFULLNAME = PGetFullName(SPOUSEFIRSTNAME)
'GETBIRTHDATE' SPOUSE
SPOUSEBIRTHDATE = RESULT
'GETDEATHDATE' SPOUSE
SPOUSEDEATHDATE = RESULT
SPOUSEFILENAME = 'P'SPOUSE
WriteCH('PERSONFILE',indent'spouse: ')
IF SPOUSELASTNAME ~= "" THEN
WriteCh('PERSONFILE','@{" ')
WriteCh('PERSONFILE',MSPOUSEFULLNAME)
IF SPOUSELASTNAME ~= "" THEN
WriteCh('PERSONFILE',' " LINK "'SPOUSEFILENAME'.guide/Main"}')
IF SPOUSEBIRTHDATE ~= "" THEN
WriteCh('PERSONFILE',' b:'SPOUSEBIRTHDATE)
IF SPOUSEDEATHDATE ~= "" THEN
WriteCh('PERSONFILE',' d:'SPOUSEDEATHDATE)
WriteLn('PERSONFILE','')
indent2 = indent || " | "
DO k = 0 TO 39 /* ??? GETTOTCHILDREN FGRN ??? */
'GETCHILD' mFGRN k
mFGRNc = RESULT
'GETFIRSTNAME' mFGRNc
mFGRNcFIRSTNAME = RESULT
IF mFGRNcFIRSTNAME ~= "" THEN DO
'GETLASTNAME' mFGRNc
mFGRNcLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' mFGRNc
mFGRNcFIRSTNAME = RESULT
'GETSEX' mFGRNc
mFGRNcGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
thelastname = mFGRNcLASTNAME
thegender = mFGRNcGENDER
mFGRNcFULLNAME = GetFullName(mFGRNcFIRSTNAME)
MmFGRNcFULLNAME = MGetFullName(mFGRNcFIRSTNAME)
PmFGRNcFULLNAME = PGetFullName(mFGRNcFIRSTNAME)
'GETBIRTHDATE' mFGRNc
mFGRNcBIRTHDATE = RESULT
'GETDEATHDATE' mFGRNc
mFGRNcDEATHDATE = RESULT
mFGRNcFILENAME = 'P'mFGRNc
WriteCh('PERSONFILE',indent2||'@{" 'MmFGRNcFULLNAME' " LINK "'mFGRNcFILENAME'.guide/Main"} ')
IF mFGRNcBIRTHDATE ~= "" THEN
WriteCh('PERSONFILE',' b:'mFGRNcBIRTHDATE)
IF mFGRNcDEATHDATE ~= "" THEN
WriteCh('PERSONFILE',' d:'mFGRNcDEATHDATE)
Writeln('PERSONFILE','')
marriagesANDchildren(mFGRNc,indent2)
END
END
END
END
END
RETURN 0
GetRIRN: PROCEDURE
PARSE ARG numb ">" last
IF last = "" THEN RETURN 0
IF IsNumeric(numb) THEN RETURN numb
RETURN 0
GetaRIRN: PROCEDURE
PARSE ARG numb "]" last
IF last = "" THEN RETURN 0
IF IsNumeric(numb) THEN RETURN numb
RETURN 0
GetEnd: PROCEDURE
PARSE ARG line ">" last
IF last = "" THEN RETURN substr(line,1,length(line)-1)
RETURN substr(last,1,length(last)-1)
GetaEnd: PROCEDURE
PARSE ARG line "]" last
IF last = "" THEN RETURN substr(line,1,length(line)-1)
RETURN substr(last,1,length(last)-1)
GetLength: PROCEDURE
PARSE UPPER ARG names
nonletters = length(compress(names, xrange('A','Z')))
RETURN Length(names) - nonletters * 4 / 10
/* create a full name from first, last, and honorifics parts */
GetFullName: PROCEDURE EXPOSE thelastname
PARSE ARG firstnames "," hon
IF hon = "" THEN DO
IF length(firstnames) > 2 THEN
IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
RETURN firstnames thelastname
END
RETURN firstnames Space(thelastname) || ","hon
MGetFullName: PROCEDURE EXPOSE thelastname thegender
PARSE ARG firstnames "," hon
IF hon = "" THEN DO
IF length(firstnames) > 2 THEN
IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
RETURN firstnames thelastname
END
RETURN firstnames Space(thelastname) || ","hon
PGetFullName: PROCEDURE EXPOSE thelastname thegender
PARSE ARG firstnames "," hon
schar = "1"
uchar = "2"
IF thegender = "f" THEN DO
schar = "3"
uchar = "3"
END
IF hon = "" THEN DO
IF length(firstnames) > 2 THEN
IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
RETURN ""schar"m"firstnames thelastname""uchar"m"
END
RETURN ""schar"m"firstnames Space(thelastname) || ","hon""uchar"m"
GetLastName: PROCEDURE
PARSE ARG str
/* With "name exceptions", this routine is no longer required */
RETURN str
Tell: PROCEDURE EXPOSE outp
parse arg str
if outp then writeln(stdout, str)
return 0
TellNN: PROCEDURE EXPOSE outp
parse arg str
if outp then writech(stdout, str)
return 0
IOERR:
bline = SIGL
say "I/O error #"||RC||" detected in line "||bline||":"
say sourceline(bline)
if pgopen then Postmsg()
EXIT